unit uDZTreeView;

interface

uses
  SysUtils, Classes, Windows, Controls, CommCtrl, ComCtrls;

type
  TCheckTreeNode = class(TTreeNode)
  private
    function GetChecked: Boolean;
    procedure SetChecked(const Value: Boolean);
  public
    property Checked: Boolean read GetChecked write SetChecked;
  end;

  TCheckTreeNodeNotifyEvent = procedure(Sender: TObject;
    node: TTreeNode) of object;

  TCheckTreeView = class(TTreeView)
  private
    fOnClickNode: TCheckTreeNodeNotifyEvent;
    fOnClickNodeIcon: TCheckTreeNodeNotifyEvent;
    fOnClickCheckBox: TCheckTreeNodeNotifyEvent;
    function GetCheckBox: Boolean;
    procedure SetCheckBox(const Value: Boolean);
    function GetChecked(node: TTreeNode): Boolean;
    procedure SetChecked(node: TTreeNode; const Value: Boolean);
  protected
    procedure MouseDown(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure ClickNode(node: TTreeNode); dynamic;
    procedure ClickNodeIcon(node: TTreeNode); dynamic;
    procedure ClickCheckBox(node: TTreeNode); dynamic;
  public
    procedure CheckChildren(node: TTreeNode; flag: Boolean);
    function FullChecked(node: TTreeNode): Boolean;
    property Checked[node: TTreeNode]: Boolean
      read GetChecked write SetChecked;
  published
    property CheckBox: Boolean read GetCheckBox write SetCheckBox;
    property OnClickNode: TCheckTreeNodeNotifyEvent
      read fOnClickNode write fOnClickNode;
    property OnClickNodeIcon: TCheckTreeNodeNotifyEvent
      read fOnClickNodeIcon write fOnClickNodeIcon;
    property OnClickCheckBox: TCheckTreeNodeNotifyEvent
      read fOnClickCheckBox write fOnClickCheckBox;
  end;

implementation

const
  TVIS_CHECKED = $2000;

{ TCheckTreeNode }

function TCheckTreeNode.GetChecked: Boolean;
var
  tvi :TTVItem;
begin
  tvi.mask  := TVIF_STATE;
  tvi.hItem := ItemId;
  TreeView_GetItem(TreeView.Handle, tvi);
  Result := (tvi.state and TVIS_CHECKED) = TVIS_CHECKED;
end;

procedure TCheckTreeNode.SetChecked(const Value: Boolean);
var
  tvi :TTVItem;
begin
  FillChar(tvi, SizeOf(tvi), 0);
  tvi.hItem := ItemId;
  tvi.mask := TVIF_STATE;
  tvi.stateMask := TVIS_STATEIMAGEMASK;
  if (Value) then tvi.state :=TVIS_CHECKED
  else tvi.state := TVIS_CHECKED shr 1;
  TreeView_SetItem(TreeView.Handle, tvi);
end;

{ TCheckTreeView }

procedure TCheckTreeView.CheckChildren(node: TTreeNode; flag: Boolean);
var
  child: TTreeNode;
begin
  child := node.getFirstChild;
  while child <> nil do
  begin
    Checked[child] := flag;
    child := child.getNextSibling;
  end;
end;

procedure TCheckTreeView.ClickCheckBox(node: TTreeNode);
begin
  if (Assigned(fOnClickCheckBox)) then
    fOnClickCheckBox(Self, node);
end;

procedure TCheckTreeView.ClickNode(node: TTreeNode);
begin
  if (Assigned(fOnClickNode)) then
    fOnClickNode(Self, node);
end;

procedure TCheckTreeView.ClickNodeIcon(node: TTreeNode);
begin
  if Assigned(fOnClickNodeIcon) then
    fOnClickNodeIcon(Self, node);
end;

function TCheckTreeView.FullChecked(node: TTreeNode): Boolean;
var
  child: TTreeNode;
begin
  child := node.getFirstChild;
  while child <> nil do
  begin
    if not Checked[child] or not FullChecked(child) then
    begin
      Result := False;
      Exit;
    end;
    child := child.getNextSibling;
  end;
  Result := True;
end;

function TCheckTreeView.GetCheckBox: Boolean;
begin
  Result := (GetWindowLong(Handle, GWL_STYLE) and TVS_CHECKBOXES) <> 0;
end;

function TCheckTreeView.GetChecked(node: TTreeNode): Boolean;
var
  tvi :TTVItem;
begin
  tvi.mask  := TVIF_STATE;
  tvi.hItem := node.ItemId;
  TreeView_GetItem(Handle, tvi);
  Result := (tvi.state and TVIS_CHECKED) = TVIS_CHECKED;
end;

procedure TCheckTreeView.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  hts: THitTests;
  node: TTreeNode;
begin
  if Button = mbLeft then
  begin
    node := GetNodeAt(X, Y);
    if node <> nil then
    begin
      hts := GetHitTestInfoAt(X, Y);
      if htOnStateIcon in hts then ClickCheckBox(node)
      else if htOnIcon in hts then ClickNodeIcon(node)
      else if htOnLabel in hts then ClickNode(node);
    end;
  end;
  inherited;
end;

procedure TCheckTreeView.SetCheckBox(const Value: Boolean);
var
  style: LongInt;
begin
  style := GetWindowLong(Handle, GWL_STYLE);
  if (Value) then style := style or TVS_CHECKBOXES
  else style := style and not TVS_CHECKBOXES;
  SetWindowLong(Handle, GWL_STYLE, style);
end;

procedure TCheckTreeView.SetChecked(node: TTreeNode; const Value: Boolean);
var
  tvi :TTVItem;
begin
  FillChar(tvi, SizeOf(tvi), 0);
  tvi.hItem := node.ItemId;
  tvi.mask := TVIF_STATE;
  tvi.stateMask := TVIS_STATEIMAGEMASK;
  if (Value) then tvi.state :=TVIS_CHECKED
  else tvi.state := TVIS_CHECKED shr 1;
  TreeView_SetItem(Handle, tvi);
end;

end.
